﻿(*
    Differential Evolution implemented in F#
    -------------------------------------------------------------------------------
    Copyright © Lukas Kouril 2010 | http://www.lukaskouril.cz
    
    The source-code is available under the Microsoft Reciprocal License (Ms-RL)
    More information and documentation can be found at http://fsai.codeplex.com
*)

namespace FSharp.AI

open Random

type Extremum =
    | Minimum
    | Maximum

type DEVariant =
    | DEBest1Bin
    | DERand1Bin
    | DEBest2Bin
    | DERand2Bin

type SpecimenArgument = 
    struct
        val Type : System.Type
        val Min : float
        val Max : float
        new (typ : System.Type, min : float, max : float) = { Type = typ; Min = min; Max = max }
    end

exception ArgumentException of string

type IEvolution =
    abstract member fsRunEvolution : float -> float -> int -> int -> List<SpecimenArgument> -> DEVariant -> (float[] -> float[]) -> Extremum -> float[][] * float[]
    abstract member olRunEvolution : float -> float -> int -> int -> System.Collections.Generic.List<SpecimenArgument> -> DEVariant -> System.Func<float[], float[]> -> Extremum -> float[][] * float[]

type DE () =

    interface IEvolution with
        member this.fsRunEvolution (f : float) (cr : float) (np : int) (generations : int) (specimen : List<SpecimenArgument>) (typ : DEVariant) cf (finding : Extremum) = 
            this.Evolution f cr np generations specimen typ cf finding

        member this.olRunEvolution (f : float) (cr : float) (np : int) (generations : int) (specimen : System.Collections.Generic.List<SpecimenArgument>) (typ : DEVariant) (cf : System.Func<float[], float[]>) (finding : Extremum) =
            this.Evolution f cr np generations (Seq.toList specimen) typ (fun x -> cf.Invoke(x)) finding
            
    member this.RunEvolution (f, cr, np, generations, specimen, typ, cf, finding) = (this :> IEvolution).fsRunEvolution f cr np generations specimen typ cf finding
    member this.RunEvolution (f, cr, np, generations, specimen, typ, cf, finding) = (this :> IEvolution).olRunEvolution f cr np generations specimen typ cf finding

    member private this.Evolution (f : float) (cr : float) (np : int) (generations : int) (specimen : List<SpecimenArgument>) (typ : DEVariant) cf (finding : Extremum) =
        let mutable population : float[][] = this.GenPopulation np specimen
        let bestProgress : float[] = Array.zeroCreate generations

        for i = 0 to np-1 do
            population.[i] <- Array.copy (cf population.[i])
        
        for i = 0 to generations - 1 do
            population <- Array.copy (this.Generation population specimen f cr typ cf finding)
            bestProgress.[i] <- (Array.min population).[0]
        (population, bestProgress)

    member private this.Generation (populace : float[][]) (specimen : List<SpecimenArgument>) (f : float) (cr : float) (typ : DEVariant) cf (finding : Extremum) : float[][] = 
        let tempPopulace : float[][] = Array.zeroCreate populace.Length
        
        for i = 0 to (tempPopulace.Length - 1) do
            tempPopulace.[i] <- Array.copy (this.EVCyklus i populace specimen f cr typ cf finding)  
        tempPopulace

    member private this.GenPopulation (np : int) (specimen : List<SpecimenArgument>)  = 
        let populace = Array.zeroCreate np
        for i = 0 to np-1 do
            populace.[i] <- Array.copy (this.GetIndividual specimen)
        populace

    member private this.EVCyklus (actualIndividual : int) (populace : float[][]) (specimen : List<SpecimenArgument>) (f : float) (cr : float) (typ : DEVariant) cf (finding : Extremum) : float[] = 
        let mutable rValue = Array.copy (this.GetIndividual specimen)
        let mutable i0 : int = actualIndividual
        let mutable i1 : int = 0
        let mutable i2 : int = 0
        let mutable i3 : int = 0
        let mutable i4 : int = 0
        let mutable i5 : int = 0

        match typ with
        | DEVariant.DEBest1Bin -> 
            i1 <- Array.findIndex (fun f -> f = (Array.min populace)) populace
            while (((i1 = i2) || (i2 = i3) || (i1 = i3)) && ((i1 = i0) && (i2 = i0) && (i3 = i0))) do
                i2 <- GetInteger 0. ((float)(populace.Length - 1))
                i3 <- GetInteger 0. ((float)(populace.Length - 1))
        | DEVariant.DERand1Bin ->
            while (((i1 = i2) || (i2 = i3) || (i1 = i3)) && ((i1 = i0) && (i2 = i0) && (i3 = i0))) do
                i1 <- GetInteger 0. ((float)(populace.Length - 1))
                i2 <- GetInteger 0. ((float)(populace.Length - 1))
                i3 <- GetInteger 0. ((float)(populace.Length - 1))    
        | DEVariant.DEBest2Bin ->
            i1 <- Array.findIndex (fun f -> f = (Array.min populace)) populace
            while (((i1 = i2) || (i1 = i3) || (i1 = i4) || (i1 = i5) || (i2 = i3) || (i2 = i4) || (i2 = i5) || (i3 = i4) || (i3 = i5) || (i4 = i5)) && ((i1 = i0) && (i2 = i0) && (i3 = i0)  && (i4 = i0) && (i5 = i0))) do
                i2 <- GetInteger 0. ((float)(populace.Length - 1))
                i3 <- GetInteger 0. ((float)(populace.Length - 1))
                i4 <- GetInteger 0. ((float)(populace.Length - 1))
                i5 <- GetInteger 0. ((float)(populace.Length - 1))
        | DEVariant.DERand2Bin ->
            while (((i1 = i2) || (i1 = i3) || (i1 = i4) || (i1 = i5) || (i2 = i3) || (i2 = i4) || (i2 = i5) || (i3 = i4) || (i3 = i5) || (i4 = i5)) && ((i1 = i0) && (i2 = i0) && (i3 = i0)  && (i4 = i0) && (i5 = i0))) do
                i1 <- GetInteger 0. ((float)(populace.Length - 1))
                i2 <- GetInteger 0. ((float)(populace.Length - 1))
                i3 <- GetInteger 0. ((float)(populace.Length - 1))
                i4 <- GetInteger 0. ((float)(populace.Length - 1))
                i5 <- GetInteger 0. ((float)(populace.Length - 1))    

        let DVV = Array.copy (this.GetIndividual specimen)
    
        match typ with
        | DEVariant.DEBest1Bin | DEVariant.DERand1Bin ->
            for i = 1 to (DVV.Length - 1) do
                DVV.[i] <- populace.[i2].[i] - populace.[i3].[i]
        | DEVariant.DEBest2Bin | DEVariant.DERand2Bin ->
            for i = 1 to (DVV.Length - 1) do
                DVV.[i] <- populace.[i2].[i] + populace.[i3].[i] - populace.[i4].[i] - populace.[i5].[i]
               
        let VDV = Array.copy (this.GetIndividual specimen)

        for i = 1 to (VDV.Length - 1) do
            VDV.[i] <- DVV.[i] * f

        let SV = Array.copy (this.GetIndividual specimen)

        for i = 1 to (SV.Length - 1) do
            SV.[i] <- VDV.[i] + populace.[i1].[i]

        let mutable ZV = Array.copy (this.GetIndividual specimen)

        for i = 1 to (ZV.Length - 1) do
            if (GetFloat 0. 1.) < cr then
                ZV.[i] <- SV.[i]
            else
                ZV.[i] <- populace.[i0].[i]

        for i = 1 to (ZV.Length - 1) do
            if (((float)ZV.[i] < specimen.[i-1].Min) || ((float)ZV.[i] > specimen.[i-1].Max)) then
                match finding with
                | Extremum.Minimum -> ZV.[0] <- 100000000.
                | Extremum.Maximum -> ZV.[0] <- -100000000.

        if finding = Extremum.Minimum then        
            if ZV.[0] <> 100000000. then
                ZV <- Array.copy (cf ZV)

            if ZV.[0] < populace.[i0].[0] then
                rValue <- Array.copy ZV
            else
                rValue <-Array.copy populace.[i0]
        else
            if ZV.[0] <> -100000000. then
                ZV <- Array.copy (cf ZV)

            if ZV.[0] > populace.[i0].[0] then
                rValue <- Array.copy ZV
            else
                rValue <-Array.copy populace.[i0]

        rValue
        
    member private this.GetIndividual (specimen : List<SpecimenArgument>) : float[] = 
        let mutable argumenty = [| 0. |]
        for i in specimen do
            if i.Type = typeof<int32> then argumenty <- Array.append argumenty [| (float)(GetInteger i.Min i.Max) |]
            elif i.Type = typeof<float> then argumenty <- Array.append argumenty [| GetFloat i.Min i.Max |]
            else raise (ArgumentException "Invalid type of argument!")      
        argumenty       